home *** CD-ROM | disk | FTP | other *** search
/ Chip 1997 October / CD CHIP.ISO / WebServ / server7 / bin / chat.dpr < prev    next >
Encoding:
Text File  |  1996-07-29  |  3.9 KB  |  178 lines
  1. library chat;
  2.  
  3. uses
  4.   Windows, SysUtils,
  5.   Classes,
  6.   Httpext,
  7.   ISAPISock;
  8.  
  9. var
  10.   // Note: All threads use this string to share info. This is
  11.   // dangerous and should be mediated. It is done this way here
  12.   // for illustration only.
  13.   JustSubmitted: ShortString;  
  14.  
  15. procedure SendChatText(sock: TISAPISock);
  16. var
  17.   lastString: String;
  18.   skip: Integer;
  19. begin
  20.   lastString:='';
  21.   
  22.   with sock do
  23.   begin
  24.    HHeader('ISAPI Chat', hcLtGray, hcBlack, hcBlue);
  25.    HPageStart;
  26.  
  27.    JustSubmitted:=GetServerVariable('REMOTE_ADDR')+' just joined!';
  28.  
  29.    try
  30.     repeat
  31.       if lastString<>JustSubmitted then
  32.       begin
  33.         HLine( HBold(GetServerVariable('REMOTE_ADDR')+': ')+JustSubmitted);
  34.         lastString:=JustSubmitted;
  35.       end;
  36.       Sleep(100);
  37.  
  38.       // Once a second we'll squirt out a space. HTML doesn't care
  39.       // and will in fact eat these up. The write will, however,
  40.       // generate an exception iff the pipe is ever broken.
  41.       Inc(skip);
  42.       if (skip mod 10)=0 then
  43.         Write(' ');
  44.         
  45.     until FALSE;
  46.    finally
  47.      JustSubmitted:=GetServerVariable('REMOTE_ADDR')+' just left!';
  48.    end;
  49.  
  50.    HPageEnd;
  51.   end;
  52. end;
  53.  
  54. procedure SendChatForm(sock: TISAPISock);
  55. begin
  56.   with sock do
  57.   begin
  58.     //Writeln('HTTP/1.0 200 OK');
  59.     //Writeln('Content-type: text/html');
  60.     //Writeln('Expires: 0');
  61.     //Writeln('');
  62.  
  63.     HHeader('ISAPI Chat', hcLtGray, hcBlack, hcBlue);
  64.     HPageStart;
  65.  
  66.     HFormStart('POST', '/bin/chat.dll');
  67.     HEditBox('', 'ChatString', '', 50, 50);
  68.     HFormEnd('Send', '');
  69.  
  70.     HPageEnd;
  71.   end;
  72. end;
  73.  
  74. //
  75. // Called anytime a GET is performed on this DLL
  76. //
  77. procedure ProcessGet(sock: TISAPISock);
  78. var
  79.   query: String;
  80. begin
  81.  with sock do
  82.  begin
  83.    // Blast out a header
  84.    Writeln('HTTP/1.0 200 OK');
  85.    Writeln('Content-type: text/html');
  86.    Writeln('Expires: 0');
  87.    Writeln('');
  88.  
  89.    //HHeader('ISAPI Chat', hcLtGray, hcBlack, hcBlue);
  90.    //HPageStart;
  91.  
  92.    query:=GetServerVariable('QUERY_STRING');
  93.  
  94.    if query='ChatText' then
  95.    begin
  96.      SendChatText(sock)
  97.    end
  98.    else if query='ChatForm' then
  99.    begin
  100.      SendChatForm(sock)
  101.    end
  102.    else if query='' then
  103.    begin
  104.      Writeln('<HTML><HEAD>');
  105.      Writeln('<TITLE>Test</TITLE>');
  106.      Writeln('</HEAD>');
  107.  
  108.      Writeln('<FRAMESET ROWS="90%,10%">');
  109.      Writeln('<FRAME SCROLL=AUTO SRC="/bin/chat.dll?ChatText">');
  110.      Writeln('<FRAME SCROLL=NO   SRC="/bin/chat.dll?ChatForm">');
  111.      Writeln('</FRAMESET>');
  112.      Writeln('</HTML>');
  113.    end;
  114.  end;
  115. end;
  116.  
  117.  
  118. procedure ProcessPost(sock: TISAPISock);
  119. begin
  120.   with sock do
  121.   begin
  122.     JustSubmitted:=EscapeDecode(GetFormVal('ChatString'));
  123.     SendChatForm(sock);
  124.   end;
  125. end;
  126.  
  127. // CASE MATTERS FOR THIS FUNCTION NAME
  128. function GetExtensionVersion(var ver: THSE_VERSION_INFO): Boolean; stdcall;
  129. begin
  130.   result:=True;
  131. end;
  132.  
  133. // CASE MATTERS FOR THIS FUNCTION NAME
  134. function HttpExtensionProc(var ecb: TEXTENSION_CONTROL_BLOCK): LongInt; stdcall;
  135. var
  136.   sock: TISAPISock;
  137.   method: String;
  138. begin
  139.   try
  140.     // Create the socket helper
  141.     sock:=TISAPISock.Create(ecb);
  142.  
  143.     method:=sock.GetServerVariable('REQUEST_METHOD');
  144.     if method='GET' then
  145.       ProcessGet(sock)
  146.     else if method='POST' then
  147.       ProcessPost(sock)
  148.     else
  149.     begin
  150.       sock.Writeln('HTTP/1.0 200 OK');
  151.       sock.Writeln('Content-type: text/html');
  152.       sock.Writeln('');
  153.       sock.Writeln('I didn''t understand that request');
  154.     end;
  155.  
  156.  
  157.     // Return a normal status code
  158.     StrLCopy( ecb.lpszLogData, PChar('DLL Finished with no errors'), HSE_LOG_BUFFER_LEN-1);
  159.     Result:=HSE_STATUS_SUCCESS;
  160.  
  161.     // Free the socket
  162.     sock.Free;
  163.   except
  164.     ;
  165.   end;
  166. end;
  167.  
  168. // * REQUIRED FOR DYNAMIC BINDING.
  169. // * Index values aren't need.
  170. // * Case doesn't matter here.
  171. exports
  172.   GetExtensionVersion,
  173.   HttpExtensionProc;
  174.  
  175. begin
  176. end.
  177.  
  178.